COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	FNTFAI
C00007 ENDMK
C⊗;
	TITLE	FNTFAI
	ENTRY	L3X2

PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BMAX←←12
BPTAB←13
LINTAB←←14

T←0 ↔ XLO←1 ↔ XLR←2 ↔ XHI←3 ↔ XHR←4 ↔ PICPNT←5 ↔ BITPNT←6
TT←7 ↔ PIC←10 ↔ YLO←11 ↔ NFWD←12 ↔ RASW←13 ↔ YHI←14 ↔ CHAR←15
P←17

;routine to assemble a 3 by 2 compressed character. Must initialize
;XLO, YLO for character position, CHAR to point to first word of
;character definition, PIC to point to first word of picture

RETAD:	0

L3X2:	POP	P,RETAD			; L3X2(PIC,YLO,XLO,CHAR)
	POP	P,CHAR
	POP	P,XLO
	POP	P,YLO
	POP	P,PIC
	PUSH	P,12
	MOVE	RASW,(CHAR)
	LSH	RASW,-33		;fetch raster width from font def
	MOVEI	XHI,-1(RASW)		;use it with XLO to get XHI
	ADD	XHI,XLO
	HRRZ	YHI,1(CHAR)		;get DATA ROW COUNT from def
	ADDI	YHI,-1(YLO)		;use it with YLO to get YHI
	MOVEI	BITPNT,1(CHAR)		;construct byte pointer
	TLO	BITPNT,100		;for bit array
	
	IDIVI	XLO,3			;get position of starting bit
	IDIVI	XHI,3			;and finishing bit
	SUB	XHI,XLO			;calculate number of pic bytes-1
	JUMPLE	XHI,GT1			;and if exactly one byte,
	SUB	XHR,XLR			;calculate how many bits in it-1
GT1:	ASH	XLR,1			;calculate jump offset for main loop
	SUBI	XHR,2			;and for trailing last byte
	MOVN	XHR,XHR
	ASH	XHR,1
	MOVE	T,BPTAB(PIC)		;set up skeleton byte pointer
	ADD	T,XLO			;for X
	MOVE	PICPNT,(T)

	SUB	YHI,YLO			;set up loop counter for Y
	MOVN	YHI,YLO			;contains negative count in left,
	HRL	YLO,YHI			; <TWICE> line number in right
	ASH	T,1
	ADD	YLO,T
		
YLOOP:	MOVEI	T,(YLO)			;finish up byte pointer by inserting
	ASH	T,-1			;line address for current Y position
	ADDI	T,LINTAB(PIC)
	HRR	PICPNT,(T)

	LDB	TT,PICPNT		;pick up first affected picture byte
	JUMPE	XHI,ONEWD		;is there only one altogether?
	MOVE	NFWD,XHI		;if more than one, do first fractional
	JRST	STL(XLR)		;one

FWL:	ILDB	TT,PICPNT		;and then do all the others but the last
STL:	ILDB	T,BITPNT
	ADD	TT,T
	ILDB	T,BITPNT		
	ADD	TT,T
	ILDB	T,BITPNT
	ADD	TT,T
  	CAIG	TT,BMAX(PIC)		;check for byte overflow
	MOVEI	TT,BMAX(PIC)
	DPB	TT,PICPNT		;return it
	SOJG	NFWD,FWL

	ILDB	TT,PICPNT		;the last affected byte
ONEWD:	JRST	RTL(XHR)		;see how much of it to do
RTL:	ILDB	T,BITPNT
	ADD	TT,T
	ILDB	T,BITPNT
	ADD	TT,T
	ILDB	T,BITPNT
	ADD	TT,T
  	CAIG	TT,BMAX(PIC)		;bounds check
	MOVEI	TT,BMAX(PIC)
	DPB	TT,PICPNT		;return it

	MOVE	T,BITPNT		;check if time to skip BP
	LSH	T,-36			;in font definition
	CAIGE	T,RASW			;to next line
	AND	BITPNT,[7777777777]

	AOBJN	YLO,YLOOP		;check if all lines done
	POP	P,12
	JRST	@RETAD

	END